home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / PTPL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  7KB  |  196 lines
  1. UNIT PTpl;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Template routines                             Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, OpDate, PoPTypes;
  16.  
  17. VAR
  18.   StartTime,
  19.   EndTime   : Time;
  20.   OkPath    : PathStr;
  21.  
  22. PROCEDURE AddTpl(CONST FNam: PathStr; CONST Where: S20; CONST sr: SearchRec);
  23.  
  24. IMPLEMENTATION
  25.  
  26. USES OpString, OpRoot,
  27.      OproUtil, FileUtil, StrUtil, MailUtil, LogFile, OpusMsg, Globals, Util;
  28.  
  29.   PROCEDURE FileToPkt(CONST FNam: PathStr);
  30.   VAR
  31.     f : FILE;
  32.     p : Pointer;
  33.     siz,test:Word;
  34.     ph: TPktHeader;
  35.     pmh:TPktMsgHeader;
  36.     s:STRING;
  37.   BEGIN
  38.     Addlog(' ','Converting '+FNam+' to PKT-file');
  39.     Assign(f, FNam); FileMode:=ShareRW+ShareDenyRW;
  40.     Reset(f,1);
  41.     siz:=FileSize(f);
  42.     GetMem(p,siz);
  43.     BLOCKREAD(f,p^,siz,test);
  44.     CLOSE(f);
  45.     DeleteFile(FNam);
  46.     Assign(f,RspFile);
  47.     ReWrite(f,1);
  48.     FillOutPktHeader(Cfg.Addresses[Cfg.MainAdrNum],Call,ph);
  49.     BlockWrite(f,ph,SizeOf(ph),test);
  50.     WITH pmh DO
  51.     BEGIN
  52.       StartMsg:=2;
  53.       OrigNode:=Cfg.Addresses[Cfg.MainAdrNum].Node;
  54.       DestNode:=Call.Node;
  55.       OrigNet:=Cfg.Addresses[Cfg.MainAdrNum].Net;
  56.       DestNet:=Call.Net;
  57.       s:=ToChar(ph.day)+' '+COPY(MonthString[ph.month],1,3)+' '+ToChar(ph.year MOD 100)+
  58.          '  '+ToChar(ph.hour)+':'+ToChar(ph.min)+':'+ToChar(ph.sec)+#0;
  59.       MOVE(s[1],pmh.time,20);
  60.       attr:=MsgSent+MsgPrivate;
  61.     END;
  62.     BlockWrite(f,pmh,SizeOf(pmh),Test);
  63.     s:=AsciiZ2Str(RemHello.SysOp,20)+#0+cfg.SysOp+#0+'Files from '+Cfg.System+#0+
  64.        KludgeLines(Cfg.Addresses[Cfg.MainAdrNum],Call)+#13#10;
  65.     BlockWrite(f,s[1],Length(s),test);
  66.     BlockWrite(f,p^,siz,test);
  67.     s:=#0#0#0;
  68.     BlockWrite(f,s[1],Length(s),test);
  69.     CLOSE(f);
  70.     FreeMem(p,siz);
  71.   END;
  72.  
  73.   FUNCTION TplPartNumber(CONST s: S20):BYTE;
  74.   CONST
  75.     Parts='*HEADER*FWDHEADER*NOTFOUND*FOUND*FWDBODY*TOOMANY*TOOBIG*TIMEOUT*FOOT*FWDFOOT*';
  76.            {   1       8        18      27    33      41      49     56     64     69 }
  77.   BEGIN
  78.     TplPartNumber:=Pos('*'+s+'*',Parts);
  79.   END;
  80.  
  81.   PROCEDURE AddTpl(CONST FNam: PathStr; CONST Where: S20; CONST sr: SEARCHREC);
  82.   VAR
  83.     Dt             : DateTime;
  84.     endit, endtpl, found : Boolean;
  85.     f, rsp, tpl    : PBufTextFile;
  86.     ss, s, t       : String;
  87.     hour,min,sec,wh: BYTE;
  88.   BEGIN
  89.     New(Tpl, Init(StartPath+PoPTemplateFileName, SOpenRead+ShareDenyW, 2048));
  90.     IF Tpl=NIL THEN Exit;
  91.     Found:=False;
  92.     WHILE NOT Tpl^.EoF AND NOT found DO
  93.     BEGIN
  94.       Tpl^.ReadLn(s);
  95.       s:=StUpCase(s);
  96.       IF Copy(s, 1, 1+Length(Where))='/'+where THEN found:=True;
  97.     END;
  98.     IF Found THEN
  99.     BEGIN
  100.       IF NOT ChkDir(JustPathName(FNam)) THEN
  101.       BEGIN
  102.         MakeFullDir(JustPathName(FNam));
  103.         AddLog('!', 'Creating outbound: '+JustPathName(FNam));
  104.       END;
  105.       wh:=TplPartNumber(where);
  106.       New(Rsp, InitCreate(FNam, SOpenWrite, 256));
  107.       endtpl:=False;
  108.       WHILE NOT Tpl^.EoF AND NOT endtpl DO
  109.       BEGIN
  110.         Tpl^.ReadLn(s);
  111.         IF Copy(s, 1, 1)='/' THEN endtpl:=True ELSE
  112.         BEGIN
  113.           { Global wild cards }
  114.           Replace(s, '$oursysop',Cfg.SysOp,0);
  115.           Replace(s, '$oursystem',Cfg.System,0);
  116.           Replace(s, '$curtime', currenttimestring('hh:mm:ss'), 0);
  117.           Replace(s, '$curdate', todaystring('dd/mm-yy'), 0);
  118.  
  119.           { Part-specific wild cards }
  120.  
  121.           IF wh IN [18,27,33,41,49,56] THEN
  122.             Replace(s, '$gotfilename', CPad(sr.name,12), 0);
  123.  
  124.           IF wh IN [27,33,41,49,56] THEN
  125.           BEGIN
  126.             Replace(s, '$filesize', LongIntForm('#########',sr.size), 0);
  127.  
  128.             UnPackTime(sr.Time, Dt);
  129.             WITH Dt DO
  130.             BEGIN
  131.               t:=ToChar(Day)+'/'+ToChar(Month)+'-'+ToChar(Year MOD 100)+' ';
  132.               Replace(s, '$filedate', t, 0);
  133.               t:=ToChar(Hour)+':'+ToChar(Min)+':'+ToChar(Sec)+' ';
  134.               Replace(s, '$filetime', t, 0);
  135.             END;
  136.           END;
  137.  
  138.           CASE wh OF
  139.              1  : Replace(s, '$sysopname', RemHello.sysop, 0);
  140.              8  : Replace(s,'$sysopname',FwdSysOpName,0);
  141.             18  : BEGIN
  142.                     Replace(s, '$filesize', 'UNKNOWN  ', 0);
  143.                     Replace(s, '$filedate', 'UNKNOWN  ', 0);
  144.                     Replace(s, '$filetime', 'UNKNOWN  ', 0);
  145.                     Replace(s, '$filedesc', '', 0);
  146.                   END;
  147.     27,33,41,49 : BEGIN
  148.                     IF Pos('$filedesc', s)<>0 THEN
  149.                     BEGIN
  150.                       ss:='';
  151.                       IF wh=27 THEN
  152.                       BEGIN
  153.                         New(f, Init(OkPath+'\FILES.BBS', SOpenRead+ShareDenyNone, Max64k(MaxAvail-1024)));
  154.                         endit:=False;
  155.                         IF f<>NIL THEN
  156.                         BEGIN
  157.                           WHILE NOT endit AND NOT f^.EoF DO
  158.                           BEGIN
  159.                             f^.ReadLn(ss);
  160.                             IF Pos(sr.Name, ss)=1 THEN
  161.                             BEGIN
  162.                               Delete(ss, 1, Length(sr.Name)+1);
  163.                               WHILE Copy(ss, 1, 1)=' ' DO
  164.                                 Delete(ss, 1, 1);
  165.                               endit:=True;
  166.                             END;
  167.                           END;
  168.                           Dispose(f, Done);
  169.                         END;
  170.                         IF NOT endit THEN ss:='';
  171.                       END ELSE
  172.                         ss:=ReplaceStr(OkPath, sr.name);
  173.                       Replace(s, '$filedesc', ss, 0);
  174.                     END;
  175.                   END;
  176.              64 : BEGIN
  177.                     Replace(s, '$filescnt', Long2Str(sr.attr), 0);
  178.                     Replace(s, '$filesize', Long2Str(sr.size), 0);
  179.                     EndTime:=CurrentTime;
  180.                     timediff(starttime, EndTime, Hour, Min, Sec);
  181.                     t:=ToChar(Hour)+':'+ToChar(Min)+':'+ToChar(Sec);
  182.                     Replace(s, '$reqtime', t, 0);
  183.                   END;
  184.           END;
  185.           Replace(s, #0, '', 0);
  186.           Rsp^.WriteLn(s);
  187.         END;
  188.       END;
  189.       Dispose(Rsp, Done);
  190.       IF (wh=64) And (Cfg.Request.RspAsPkt) THEN FileToPkt(FNam);
  191.     END;
  192.     Dispose(Tpl, Done);
  193.   END;
  194.  
  195. END.
  196.